Estudo do Pacote Flexmix

1 O pacote

O trabalho desenvolvido teve como objetivo estudar o pacote Flexmix e compara-lo com demais técnicas de clusterização.

O pacote trás como sua principal funcionalidade a capacidade de ajustar diferentes distribuições para as misturas, se caracterizando como um framework de misturas de modelos lineares generalizados, semi paramétrico e não paramétrico

O pacote já está disponível no cran, através de https://cran.r-project.org/web/packages/flexmix/index.html

O autor também oferece diversos artigos em forma de vignetes

2 Aplicação em Dados Reais

A primeira etapa do trabalho se baseia na aplicação de diferentes métodos de agrupamento

Os dados utilizados foram retirados do e se referem a medidas de pinguins adultos perto da Estação Palmer, Antártida (Palmer Station)

df_pengu = palmerpenguins::penguins %>%
  filter(complete.cases(.)) |>
  select(-year)

df_pengu |>
  rmarkdown::paged_table()

O conjunto de dados possui as seguintes variáveis

  • species
    • Um fator com as espécies de pinguim (Adelie, Gentoo e Chinstrap)
  • island
    • Um fator com cada ilha do Arquipélago Palmer, na Antártida (Biscoe, Dream, Togersen)
  • bill_length_mm
    • Um número inteiro que indica o comprimento do bico (em milímetros)
  • bill_depth_mm
    • Um número inteiro que indica a profundidade do bico (em milímetros)
  • flipper_length_mm
    • Um número inteiro que indica o comprimento da nadadeira (em milímetros)
  • body_mass_g
    • Um número inteiro que indica a massa corporal (em gramas)
  • sex
    • Um fator que indica o sexo do(a) pinguim (macho, fêmea)

Os Penguinos

As 3 variáveis categóricas podem se mostrar de interesse para construção de grupos

df_pengu |>
  group_by(
    across(
      where(is.factor)
      )
    ) |>
  summarise(
    across(
      where(is.numeric),
      ~mean(.)
      )
    ) |>
  rmarkdown::paged_table()
`summarise()` has grouped output by 'species', 'island'. You can override using
the `.groups` argument.
df_pengu  |>
    tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  ungroup() |>
  mutate(species_sex = glue::glue("{species}_{sex}") |>
           as.character(),
         .keep = 'unused') |>
  ggplot(aes(x = species_sex, y = value, fill = species_sex)) +
  geom_violin(drop = F) +
  facet_wrap(~name, scales = 'free') +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())

Vemos que a variável de espécie e sexo são aquelas a apresentarem maiores divisões entre os pinguins e assim desejamos ver que essa separação seja capturada pelos algoritmos de agrupamento

É importante destacar que tais variáveis categóricas serão ‘escondidas’ para algoritmos de agrupamento.

3 diferentes algoritmos foram utilizados: AGNES, K-Means e Modelos de Misturas

2.1 AGNES

AGNES(AGglomerative NESting) é um método de agrupamento hierárquico aglomerativo.

df_pengu_scl_num = df_pengu |>
  select(
    where(is.numeric)
    ) |>
  mutate(
    across(
      where(is.numeric), 
    ~scale(.)
    )
  )


agnes_cluter = df_pengu_scl_num |>
  factoextra::get_dist() |>
  hclust(method = 'complete')
fviz_nbclust(df_pengu_scl_num, FUN = hcut, method = "wss")

fviz_nbclust(df_pengu_scl_num, FUN = hcut, method = "silhouette")

fviz_nbclust(df_pengu_scl_num, FUN = hcut, method = "gap_stat")

plot(agnes_cluter)
rect.hclust(agnes_cluter, k=5)

fviz_cluster(
  list(data = df_pengu_scl_num, 
       cluster = cutree(agnes_cluter, k = 5)),
  ellipse = TRUE,
  ellipse.type = "norm"
  )

2.2 K-Means

A clusterização via K-means (MacQueen 1967) é um dos algoritmos de aprendizado de máquina não supervisionado mais comumente usados para particionar um determinado conjunto de dados em um conjunto de k grupos (ou seja, k clusters), onde k representa o número de grupos pré-especificados pelo analista.

Assim como no método hierárquico, foi definido um número de grupos igual a 5

kmeans_cluter = df_pengu_scl_num |> 
  kmeans(centers = 5, nstart = 35)
fviz_cluster(kmeans_cluter, 
             data = df_pengu_scl_num,
             ellipse = TRUE,
             ellipse.type = "norm"
  )

2.3 Misturas

Para a aplicação de modelos de misturas, o pacote flexmix, já introduzido, foi utilizado

O algoritmo se mostrou extremamente inconsistente, com diferentes resultados a cada execução

df_pengu_scl_num %>%
  flexmix::flexmix(bill_length_mm + bill_depth_mm + 
                     flipper_length_mm + body_mass_g ~ 1, data = ., k = 5) 

Call:
flexmix::flexmix(formula = bill_length_mm + bill_depth_mm + flipper_length_mm + 
    body_mass_g ~ 1, data = ., k = 5)

Cluster sizes:
  1   2   3   4   5 
105 111   1 108   8 

no convergence after 200 iterations
df_pengu_scl_num %>%
  flexmix::flexmix(bill_length_mm + bill_depth_mm + 
                     flipper_length_mm + body_mass_g ~ 1, data = ., k = 5) 

Call:
flexmix::flexmix(formula = bill_length_mm + bill_depth_mm + flipper_length_mm + 
    body_mass_g ~ 1, data = ., k = 5)

Cluster sizes:
  1   2   3   4   5 
  0  94 133   0 106 

no convergence after 200 iterations
df_pengu_scl_num %>%
  flexmix::flexmix(bill_length_mm + bill_depth_mm + 
                     flipper_length_mm + body_mass_g ~ 1, data = ., k = 5) 

Call:
flexmix::flexmix(formula = bill_length_mm + bill_depth_mm + flipper_length_mm + 
    body_mass_g ~ 1, data = ., k = 5)

Cluster sizes:
  1   2   3   4   5 
 96 113   0   0 124 

convergence after 183 iterations

É possível a execução da função resultou em grandes diferenças no tamanho de cada grupo quando essa convergia, e em certos casos o algoritmo não convergiu após 200 iterações. Vale destacar que a função não possui um argumento para definção do número máximo de iterações.

3 Etapa de Simulação

A segunda etapa do trabalho buscou estudar a capacidade de agrupamento do algoritmo utilizado no pacote via estudo de simulação

Estudos de grupos menos e mais semelhantes entre si foi realizado, onde para isso foram definidos 3 simulações bases

  • Grupos diferentes apenas na média
    • Foram simulados grupos que se diferem em 10, 5, e 1 unidade de média, com o desvio-padrão fixado em 1
mix_mean_change = 
  list(near = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 1, sd = 1),
           c3 = rnorm(100, mean = 2, sd = 1)),
       between = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 5, sd = 1),
           c3 = rnorm(100, mean = 10, sd = 1)),
       far = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 10, sd = 1),
           c3 = rnorm(100, mean = 20, sd = 1))
       )
mix_mean_change |> 
  as.data.frame() |> 
  tidyr::pivot_longer(where(is.numeric)) |>
  dplyr::mutate(name = name |>
           stringr::str_remove_all("\\..*$")) |>
  ggplot(aes(x = value, fill = name)) +
  geom_histogram() +
  facet_wrap(~name, ncol = 1, scales = 'free')
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

  • Grupos diferentes apenas no desvio-padrão
    • Foram simulados grupos que se diferem em 10, 5, e 1 unidade de desvio-padrão, com a média fixada em 0
mix_sd_change = 
  list(near = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 0, sd = 2),
           c3 = rnorm(100, mean = 0, sd = 3)),
       between = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 0, sd = 5),
           c3 = rnorm(100, mean = 0, sd = 10)),
       far = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 0, sd = 10),
           c3 = rnorm(100, mean = 0, sd = 20))
       )
mix_sd_change |> 
  as.data.frame() |> 
  tidyr::pivot_longer(where(is.numeric)) |>
  dplyr::mutate(name = name |>
           stringr::str_remove_all("\\..*$")) |>
  ggplot(aes(x = value, fill = name)) +
  geom_histogram() +
  facet_wrap(~name, ncol = 1, scales = 'free')
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

  • Grupos diferentes em média e desvio-padrão
    • Foram simulados grupos que se diferem em 5, e 1 unidade de média e desvio-padrão. Buscando a complexidade do trabalho, as seguintes combinações foram realizadas
  1. 1 unidades de distância na média
  • 1, 2 e 5 unidades de distância no desvio padrão
  1. 3 unidades de distância na média
  • 1, 2 e 5 unidades de distância no desvio padrão
mix_mean_sd_change1 = 
  list(near = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 3, sd = 2),
           c3 = rnorm(100, mean = 6, sd = 3)),
       between = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 3, sd = 3),
           c3 = rnorm(100, mean = 6, sd = 5)),
       far = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 3, sd = 5),
           c3 = rnorm(100, mean = 6, sd = 10))
       )

mix_mean_sd_change2 = 
  list(near = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 1, sd = 2),
           c3 = rnorm(100, mean = 2, sd = 3)),
       between = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 1, sd = 3),
           c3 = rnorm(100, mean = 2, sd = 5)),
       far = 
         tibble::tibble(
           c1 = rnorm(100, mean = 0, sd = 1),
           c2 = rnorm(100, mean = 1, sd = 5),
           c3 = rnorm(100, mean = 2, sd = 10))
       )
mix_mean_sd_change1 |> 
  as.data.frame() |> 
  tidyr::pivot_longer(where(is.numeric)) |>
  dplyr::mutate(name = name |>
           stringr::str_remove_all("\\..*$")) |>
  ggplot(aes(x = value, fill = name)) +
  geom_histogram() +
  facet_wrap(~name, ncol = 1, scales = 'free')
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

mix_mean_sd_change2 |> 
  as.data.frame() |> 
  tidyr::pivot_longer(where(is.numeric)) |>
  dplyr::mutate(name = name |>
           stringr::str_remove_all("\\..*$")) |>
  ggplot(aes(x = value, fill = name)) +
  geom_histogram() +
  facet_wrap(~name, ncol = 1, scales = 'free')
`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Para os 3 casos, foram simulados grupos a partir de uma distribuição Normal com tamanho amostral 300.

3.1 AGNES

3.1.1 Variando a Média

Primeiramente o algoritmo foi aplicado nos grupos com seperação de 10 unidade na média

agnes_far_cluster = mix_mean_change$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_far_cluster)
rect.hclust(agnes_far_cluster, k=3)

A segunda etapa foi a aplicação do método nos dados com grupos se distanciando em 5 unidades na média

agnes_between_cluster = mix_mean_change$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_between_cluster)
rect.hclust(agnes_between_cluster, k=3)

A útlima etapa foi aplicação do método nos dados que possuiam os grupos mais próximos, com apenas 1 unidade de distancia na média

agnes_near_cluster = mix_mean_change$near |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_near_cluster)
rect.hclust(agnes_near_cluster, k=3)

3.1.2 Variando o Desvio Padrão

agnes_far_cluster = mix_sd_change$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_far_cluster)
rect.hclust(agnes_far_cluster, k=3)

agnes_between_cluster = mix_sd_change$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_between_cluster)
rect.hclust(agnes_between_cluster, k=3)

agnes_near_cluster = mix_sd_change$near |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_near_cluster)
rect.hclust(agnes_near_cluster, k=3)

3.1.3 Variando a Média e o Desvio Padrão

agnes_far_cluster = mix_mean_sd_change1$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_far_cluster)
rect.hclust(agnes_far_cluster, k=3)

agnes_between_cluster = mix_mean_sd_change1$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_between_cluster)
rect.hclust(agnes_between_cluster, k=3)

agnes_near_cluster = mix_mean_sd_change1$near |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_near_cluster)
rect.hclust(agnes_near_cluster, k=3)

agnes_far_cluster = mix_mean_sd_change2$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_far_cluster)
rect.hclust(agnes_far_cluster, k=3)

agnes_between_cluster = mix_mean_sd_change2$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_between_cluster)
rect.hclust(agnes_between_cluster, k=3)

agnes_near_cluster = mix_mean_sd_change2$near |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |>
  factoextra::get_dist() |>
  hclust(method = 'complete') 


plot(agnes_near_cluster)
rect.hclust(agnes_near_cluster, k=3)

3.2 K-Means

3.2.1 Variando a Média

kmeans_far_cluster = mix_mean_change$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |> 
  kmeans(centers = 3, nstart = 35)
mix_mean_change$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  mutate(fitted = kmeans_far_cluster$cluster) |>
  rename(actual = name) |>
  mutate(actual = actual |>
           stringr::str_remove("[^0-9]") |> 
           as.numeric() ) |>
  mutate(correct = 
           case_when(actual == fitted ~ T,
                             .default = F),
         actual = 
           actual |> 
           as.character()) |>
  group_by(actual) |>
  summarise(media = mean(correct)) |>
  ggplot(aes(x = actual, y = media, fill = actual)) +
  geom_col() +
  labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
  theme_minimal()

kmeans_between_cluster = mix_mean_change$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |> 
  kmeans(centers = 3, nstart = 35)

kmeans_between_cluster
K-means clustering with 3 clusters of sizes 101, 99, 100

Cluster means:
          [,1]
1  9.975944889
2  4.860534736
3 -0.004163329

Clustering vector:
  [1] 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3
 [38] 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2
 [75] 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1
[112] 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3
[149] 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2
[186] 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1
[223] 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3
[260] 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 2 1 3 1 1 3 2 1 3 2
[297] 1 3 2 1

Within cluster sum of squares by cluster:
[1] 95.27231 84.17836 96.01847
 (between_SS / total_SS =  94.8 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"      
mix_mean_change$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  mutate(fitted = kmeans_between_cluster$cluster) |>
  rename(actual = name) |>
  mutate(actual = actual |>
           stringr::str_remove("[^0-9]") |> 
           as.numeric() ) |>
  mutate(correct = 
           case_when(actual == fitted ~ T,
                             .default = F),
         actual = 
           actual |> 
           as.character()) |>
  group_by(actual) |>
  summarise(media = mean(correct)) |>
  ggplot(aes(x = actual, y = media, fill = actual)) +
  geom_col() +
  labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
  theme_minimal()

kmeans_near_cluster = mix_mean_change$near |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |> 
  kmeans(centers = 3, nstart = 35)

kmeans_near_cluster
K-means clustering with 3 clusters of sizes 69, 89, 142

Cluster means:
       [,1]
1  2.638624
2 -0.536972
3  1.116439

Clustering vector:
  [1] 3 3 1 2 3 1 3 1 3 2 1 3 3 2 3 3 3 3 3 3 3 3 2 3 3 3 3 3 3 1 2 3 3 2 3 3 3
 [38] 3 3 2 3 1 2 3 1 2 3 3 2 2 1 2 3 1 2 1 3 2 3 3 2 3 3 2 3 3 2 2 1 3 3 3 3 3
 [75] 1 2 2 3 3 1 3 2 3 1 2 3 3 2 3 1 2 2 1 3 3 1 2 1 1 2 2 1 3 1 3 3 3 3 2 1 1
[112] 3 1 1 2 2 1 2 3 3 3 3 3 2 3 1 2 3 1 2 1 3 3 1 2 2 3 3 2 3 3 2 3 3 3 3 1 2
[149] 2 1 2 2 1 2 1 3 2 2 1 2 3 1 3 1 1 3 3 1 2 3 3 3 1 1 2 3 1 3 2 3 2 1 3 2 3
[186] 3 3 3 3 2 1 1 2 3 3 2 2 1 2 2 3 2 3 3 3 2 1 3 1 3 2 3 1 2 2 3 3 3 3 2 3 1
[223] 2 3 1 3 2 1 2 1 3 3 3 1 2 3 3 2 3 3 2 3 1 2 3 1 2 3 3 2 2 1 2 1 3 2 2 1 3
[260] 2 3 2 3 3 2 2 1 2 2 1 3 3 3 3 3 3 3 3 3 3 3 1 2 3 1 2 3 1 2 1 1 2 2 3 3 2
[297] 1 3 1 1

Within cluster sum of squares by cluster:
[1] 19.25048 34.68209 30.44576
 (between_SS / total_SS =  82.5 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"      
mix_mean_change$near |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  mutate(fitted = kmeans_near_cluster$cluster) |>
  rename(actual = name) |>
  mutate(actual = actual |>
           stringr::str_remove("[^0-9]") |> 
           as.numeric() ) |>
  mutate(correct = 
           case_when(actual == fitted ~ T,
                             .default = F),
         actual = 
           actual |> 
           as.character()) |>
  group_by(actual) |>
  summarise(media = mean(correct)) |>
  ggplot(aes(x = actual, y = media, fill = actual)) +
  geom_col() +
  labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
  theme_minimal()

3.2.2 Variando o Desvio Padrão

kmeans_far_cluster = mix_sd_change$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |> 
  kmeans(centers = 3, nstart = 35)
mix_mean_change$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  mutate(fitted = kmeans_far_cluster$cluster) |>
  rename(actual = name) |>
  mutate(actual = actual |>
           stringr::str_remove("[^0-9]") |> 
           as.numeric() ) |>
  mutate(correct = 
           case_when(actual == fitted ~ T,
                             .default = F),
         actual = 
           actual |> 
           as.character()) |>
  group_by(actual) |>
  summarise(media = mean(correct)) |>
  ggplot(aes(x = actual, y = media, fill = actual)) +
  geom_col() +
  labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
  theme_minimal()

kmeans_between_cluster = mix_sd_change$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |> 
  kmeans(centers = 3, nstart = 35)

kmeans_between_cluster
K-means clustering with 3 clusters of sizes 204, 58, 38

Cluster means:
         [,1]
1  -0.3789894
2   9.0984744
3 -11.3411884

Clustering vector:
  [1] 1 1 3 1 1 1 1 3 2 1 1 3 1 2 3 1 3 3 1 1 1 1 2 1 1 1 1 1 1 2 1 1 2 1 1 1 1
 [38] 1 1 1 2 2 1 2 2 1 1 1 1 1 1 1 3 2 1 1 1 1 2 2 1 2 3 1 1 1 1 2 2 1 1 2 1 2
 [75] 3 1 1 1 1 1 2 1 1 2 1 1 2 1 1 3 1 1 1 1 1 2 1 1 3 1 2 2 1 1 1 1 1 3 1 1 2
[112] 1 3 3 1 1 3 1 1 1 1 1 2 1 1 2 1 1 3 1 1 1 1 1 2 1 3 2 1 1 2 1 1 3 1 1 1 1
[149] 1 3 1 3 2 1 1 3 1 3 2 1 2 1 1 1 2 1 1 3 1 1 1 1 3 1 1 1 3 1 1 3 1 1 2 1 1
[186] 2 1 1 1 1 2 2 1 1 3 1 3 1 1 1 1 1 2 1 1 1 2 1 1 2 1 3 1 1 1 3 1 2 1 1 1 2
[223] 1 2 1 1 3 3 1 1 2 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 2 1 1 1 1 1 2 1 3 1 1
[260] 1 2 1 2 2 1 2 2 1 1 3 1 2 2 1 3 2 1 3 2 1 1 1 1 1 1 1 1 3 1 1 1 1 1 2 1 1
[297] 1 1 1 3

Within cluster sum of squares by cluster:
[1] 1025.767 1557.041 1205.821
 (between_SS / total_SS =  71.9 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"

3.2.3 Variando a Média e o Desvio Padrão

kmeans_far_cluster = mix_mean_sd_change1$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |> 
  kmeans(centers = 3, nstart = 35)
mix_mean_sd_change1$far |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  mutate(fitted = kmeans_far_cluster$cluster) |>
  rename(actual = name) |>
  mutate(actual = actual |>
           stringr::str_remove("[^0-9]") |> 
           as.numeric() ) |>
  mutate(correct = 
           case_when(actual == fitted ~ T,
                             .default = F),
         actual = 
           actual |> 
           as.character()) |>
  group_by(actual) |>
  summarise(media = mean(correct)) |>
  ggplot(aes(x = actual, y = media, fill = actual)) +
  geom_col() +
  labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
  theme_minimal()

kmeans_between_cluster = mix_mean_sd_change1$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |> 
  kmeans(centers = 3, nstart = 35)

kmeans_between_cluster
K-means clustering with 3 clusters of sizes 52, 154, 94

Cluster means:
         [,1]
1  9.90646106
2 -0.06857094
3  4.43597177

Clustering vector:
  [1] 2 3 3 2 2 3 2 3 3 2 3 1 2 2 3 2 3 1 2 2 1 2 3 2 2 2 1 2 1 2 2 3 1 2 3 1 2
 [38] 2 2 2 1 2 2 2 2 2 2 3 2 3 2 2 3 1 2 3 1 2 3 3 2 2 1 2 2 2 2 3 3 2 2 1 2 3
 [75] 1 2 3 3 2 3 1 2 1 1 2 3 1 2 2 3 2 2 3 2 3 2 2 2 3 3 3 3 2 3 3 2 2 3 2 2 1
[112] 2 2 3 2 3 2 2 1 2 2 3 3 2 3 1 3 1 1 2 2 3 2 3 3 2 2 1 2 3 3 2 1 1 2 3 2 2
[149] 3 1 2 3 3 2 2 2 2 3 2 2 3 3 2 2 3 2 1 3 2 1 1 2 2 1 2 3 1 2 2 3 2 2 1 2 3
[186] 1 2 3 3 2 3 1 2 3 1 2 3 3 2 3 2 2 2 3 2 3 3 2 3 1 2 3 1 2 3 3 2 3 1 2 2 3
[223] 2 3 2 2 3 2 2 2 1 2 3 1 2 2 1 2 3 1 2 2 3 2 3 3 2 2 1 2 2 1 2 3 2 2 3 2 2
[260] 3 1 2 1 1 2 3 3 2 3 2 2 1 2 2 2 3 3 3 1 2 2 1 2 3 1 2 3 1 2 3 3 2 3 2 2 2
[297] 2 2 2 2

Within cluster sum of squares by cluster:
[1] 230.0827 293.7327 187.4806
 (between_SS / total_SS =  85.3 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"      
mix_mean_sd_change1$between |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  mutate(fitted = kmeans_between_cluster$cluster) |>
  rename(actual = name) |>
  mutate(actual = actual |>
           stringr::str_remove("[^0-9]") |> 
           as.numeric() ) |>
  mutate(correct = 
           case_when(actual == fitted ~ T,
                             .default = F),
         actual = 
           actual |> 
           as.character()) |>
  group_by(actual) |>
  summarise(media = mean(correct)) |>
  ggplot(aes(x = actual, y = media, fill = actual)) +
  geom_col() +
  labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
  theme_minimal()

kmeans_near_cluster = mix_mean_sd_change1$near |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  dplyr::pull(value) |> 
  kmeans(centers = 3, nstart = 35)

kmeans_near_cluster
K-means clustering with 3 clusters of sizes 51, 150, 99

Cluster means:
      [,1]
1 8.483998
2 0.419360
3 4.326275

Clustering vector:
  [1] 2 3 1 2 2 3 2 3 1 2 3 3 2 2 1 2 1 1 2 3 2 2 3 3 2 3 3 2 3 3 2 3 1 2 3 1 2
 [38] 3 1 2 3 2 2 3 1 2 2 3 2 3 1 2 2 3 2 3 2 2 2 3 2 3 3 2 2 1 2 2 3 2 2 1 2 2
 [75] 1 2 3 1 2 2 1 2 1 3 2 3 3 2 3 2 2 2 3 2 3 3 2 3 1 2 2 1 2 2 3 2 3 1 2 2 3
[112] 2 3 1 2 3 3 2 3 1 2 3 3 2 1 1 2 3 3 2 3 1 2 3 1 2 2 2 2 2 1 2 3 1 2 2 3 2
[149] 2 1 2 2 1 2 2 1 2 2 3 2 2 3 2 2 1 2 2 1 2 2 1 2 2 1 2 3 1 2 3 2 2 1 1 2 3
[186] 3 2 2 1 2 2 3 2 2 3 2 3 1 2 3 3 2 3 3 2 3 3 2 3 1 2 2 3 2 3 1 2 3 2 2 2 1
[223] 2 3 3 2 2 1 2 3 1 2 3 1 2 3 1 2 2 1 2 3 3 2 3 3 2 2 2 2 3 3 2 3 2 2 2 3 2
[260] 3 1 2 3 3 2 3 3 2 2 1 2 3 3 2 3 1 2 3 2 2 2 3 2 2 3 2 2 3 2 2 3 2 3 3 2 3
[297] 1 2 3 3

Within cluster sum of squares by cluster:
[1] 111.2805 186.9337 136.6998
 (between_SS / total_SS =  86.1 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"      
mix_mean_sd_change1$near |>
   tidyr::pivot_longer(
    where(
      is.numeric
      )
    ) |>
  mutate(fitted = kmeans_near_cluster$cluster) |>
  rename(actual = name) |>
  mutate(actual = actual |>
           stringr::str_remove("[^0-9]") |> 
           as.numeric() ) |>
  mutate(correct = 
           case_when(actual == fitted ~ T,
                             .default = F),
         actual = 
           actual |> 
           as.character()) |>
  group_by(actual) |>
  summarise(media = mean(correct)) |>
  ggplot(aes(x = actual, y = media, fill = actual)) +
  geom_col() +
  labs(title = 'Proporção de Acertos por Grupo', x = 'Grupo', y = 'Proporção Acertos') +
  theme_minimal()